home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / soundu / dilaudid.zip / PLAYHP / PLAYHP.BAS < prev    next >
BASIC Source File  |  1993-12-31  |  5KB  |  185 lines
  1. DECLARE SUB doplay (dat%)
  2. DECLARE SUB d1 ()
  3. DECLARE SUB d2 ()
  4. DECLARE SUB playnote (note$, oct%)
  5. DECLARE SUB stopplay ()
  6. DECLARE SUB setoptions (am%, vibrato%, sustain%, harmonic%)
  7. DECLARE SUB setlevel (level%)
  8. DECLARE SUB setad (attack%, decay%)
  9. DECLARE SUB setsr (sustain%, release%)
  10. DECLARE SUB setwave (wavetype%)
  11. DECLARE SUB delay ()
  12. DEFINT A-Z
  13. COMMON SHARED curvoice, curoctave, curlength, deflength, curtempo
  14.  
  15. curtempo = 120
  16.  
  17. file$ = COMMAND$
  18. IF file$ = "" THEN
  19.         PRINT "playhp FILENAME"
  20.         END
  21. END IF
  22.  
  23. deflength = 16  'quarter note default
  24.  
  25. FOR curvoice = 0 TO 2
  26.         setoptions 0, 0, 0, 0
  27.         setlevel 60
  28.         setad 9, 4
  29.         setsr 4, 4
  30.         setwave 1
  31. NEXT
  32. curvoice = 0
  33.  
  34. CLS
  35.  
  36. OPEN file$ FOR BINARY AS #1
  37.  
  38. DO
  39.         IF NOT (EOF(1)) THEN x = ASC(INPUT$(1, #1))
  40.         doplay x
  41. LOOP UNTIL EOF(1) OR INKEY$ <> ""
  42.  
  43. CLOSE
  44.  
  45. SUB d1
  46.         FOR r = 1 TO 6: x = INP(&H388): NEXT
  47. END SUB
  48.  
  49. SUB d2
  50.         FOR r = 1 TO 35: x = INP(&H388): NEXT
  51. END SUB
  52.  
  53. SUB delay
  54.         x# = (1 / curlength) * (60 / curtempo)
  55.         xx# = TIMER + x#
  56.         DO UNTIL TIMER > xx#: LOOP
  57. END SUB
  58.  
  59. SUB doplay (dat)
  60.         curvoice = 0
  61.         curlength = 8
  62.         curoctave = dat \ 25
  63.         x$ = "defgabccccc"
  64.         n$ = MID$(x$, ((dat MOD 25) \ 4) + 1, 1)
  65.         stopplay
  66.         playnote n$, curoctave
  67.         PRINT n$ + "/o" + LTRIM$(RTRIM$(STR$(curoctave))) + " ";
  68.         delay
  69.  
  70. END SUB
  71.  
  72. SUB playnote (note$, oct)
  73. SELECT CASE LCASE$(note$)
  74.         CASE "c#", "c+", "d-"
  75.                 msb = &H1: lsb = &H6B
  76.         CASE "d"
  77.                 msb = &H1: lsb = &H81
  78.         CASE "d#", "d+", "e-"
  79.                 msb = &H1: lsb = &H98
  80.         CASE "e"
  81.                 msb = &H1: lsb = &HB0
  82.         CASE "f"
  83.                 msb = &H1: lsb = &HCA
  84.         CASE "f#", "f+", "g-"
  85.                 msb = &H1: lsb = &HE5
  86.         CASE "g"
  87.                 msb = &H2: lsb = &H2
  88.         CASE "g#", "g+", "a-"
  89.                 msb = &H2: lsb = &H20
  90.         CASE "a"
  91.                 msb = &H2: lsb = &H41
  92.         CASE "a#", "a+", "b-"
  93.                 msb = &H2: lsb = &H63
  94.         CASE "b"
  95.                 msb = &H2: lsb = &H87
  96.         CASE "c"
  97.                 msb = &H2: lsb = &HAE
  98.         CASE ELSE
  99.                 COLOR 12
  100.                 PRINT "ERR ";
  101. END SELECT
  102.  
  103.         OUT &H388, &HA0 + curvoice: d1
  104.         OUT &H389, lsb: d2
  105.         OUT &H388, &HA3 + curvoice: d1
  106.         OUT &H389, lsb: d2
  107.  
  108.         OUT &H388, &HB0 + curvoice: d1
  109.         OUT &H389, msb + (oct * 4) + 32: d2
  110.         OUT &H388, &HB3 + curvoice: d1
  111.         OUT &H389, msb + (oct * 4) + 32: d2
  112.  
  113. END SUB
  114.  
  115. SUB setad (attack, decay)
  116.         OUT &H388, &H60 + curvoice: d1
  117.         OUT &H389, (attack * 16) + decay: d2
  118.         OUT &H388, &H63 + curvoice: d1
  119.         OUT &H389, (attack * 16) + decay: d2
  120. END SUB
  121.  
  122. SUB setlevel (level)
  123.         OUT &H388, &H40 + curvoice: d1
  124.         OUT &H389, (63 - level): d2
  125.         OUT &H388, &H43 + curvoice: d1
  126.         OUT &H389, (63 - level): d2
  127. END SUB
  128.  
  129. SUB setoptions (am, vibrato, sustain, harmonic)
  130.         temp = 0
  131.         IF am THEN temp = 128
  132.         IF vibrato THEN temp = temp + 64
  133.         IF sustain THEN temp = temp + 32
  134.         '       harmonic options:
  135.         '            0 - one octave below
  136.         '            1 - at the voice's specified frequency
  137.         '            2 - one octave above
  138.         '            3 - an octave and a fifth above
  139.         '            4 - two octaves above
  140.         '            5 - two octaves and a major third above
  141.         '            6 - two octaves and a fifth above
  142.         '            7 - two octaves and a minor seventh above
  143.         '            8 - three octaves above
  144.         '            9 - three octaves and a major second above
  145.         '           10 - three octaves and a major third above
  146.         '           11 -  "       "     "  "   "     "     "
  147.         '           12 - three octaves and a fifth above
  148.         '           13 -   "      "     "  "   "     "
  149.         '           14 - three octaves and a major seventh above
  150.         '           15 -   "      "     "  "   "      "      "
  151.         temp = temp + harmonic
  152.         OUT &H388, &H20 + curvoice: d1
  153.         OUT &H389, temp: d2
  154.         OUT &H388, &H23 + curvoice: d1
  155.         OUT &H389, temp: d2
  156. END SUB
  157.  
  158. SUB setsr (sustain, release)
  159.         OUT &H388, &H80 + curvoice: d1
  160.         OUT &H389, ((15 - sustain) * 16) + release: d2
  161.         OUT &H388, &H83 + curvoice: d1
  162.         OUT &H389, ((15 - sustain) * 16) + release: d2
  163. END SUB
  164.  
  165. SUB setwave (wavetype)
  166.         OUT &H388, &HE0 + curvoice: d1
  167.         '   ___              ___            ___    ___       _      _
  168.         '  /   \            /   \          /   \  /   \     / |    / |
  169.         ' /_____\_______   /_____\_____   /_____\/_____\   /__|___/__|___
  170.         '        \     /
  171.         '         \___/
  172.         '     -0-             -1-              -2-             -3-
  173.         OUT &H389, wavetype: d2
  174.         OUT &H388, &HE3 + curvoice: d1
  175.         OUT &H389, wavetype: d2
  176. END SUB
  177.  
  178. SUB stopplay
  179.         OUT &H388, &HB0 + curvoice: d1
  180.         OUT &H389, 0: d2
  181.         OUT &H388, &HB3 + curvoice: d1
  182.         OUT &H389, 0: d2
  183. END SUB
  184.  
  185.